R Notebook

Todo:

• add columns for totals for each pollutant/sector

# load libraries and read data
library(tidyverse)
library(readxl)
library(plotly)

ghg_emissions_clean <- read_csv("data/clean_data/ghg_emissions.csv")

-- Column specification ----------------------------------------------------------------------------------------------------------------------------
cols(
  ccp_mapping = col_character(),
  source_name = col_character(),
  pollutant = col_character(),
  year = col_double(),
  value = col_double(),
  units = col_character()
)

Only emissions - > emissions that are greater than 0

ghg_true_emissions <- ghg_emissions_clean %>% 
  filter(year == max(ghg_true_emissions$year)) %>% 
  filter(value >= 0) %>% 
  mutate(across(where(is.character), ~str_to_title(.)))

n_children

[1] 1 0 2

ghg_true_emissions %>% 
  distinct(source_name) %>% 
  mutate(source_name = str_count(source_name, " - ")) %>% 
  summarise(max(source_name))

# get sector totals for parent df (top level)

ghg_sector_totals <- ghg_true_emissions %>% 
  group_by(ccp_mapping) %>% 
  summarise(sector_total = sum(value), .groups = "drop_last")

parent_df <- ghg_sector_totals %>% 
  mutate(parent = "") %>% 
  select(label = ccp_mapping,
         parent,
         value = sector_total)

# the rest of the data

children_df <- ghg_true_emissions %>% 
  filter(year == max(ghg_true_emissions$year)) %>% 
  group_by(source_name, ccp_mapping) %>% 
  summarise(value = sum(value), .groups = "drop_last") %>% 
  select(label = source_name,
         parent = ccp_mapping,
         value)

# combine into one hierarchical df, create id column

emissions_long <- bind_rows(list(parent_df, children_df)) %>% 
  mutate(id = paste(parent, label, sep = " - "), .before = 'label') %>% 
  mutate(id = str_remove(id, "^ - "))

Other method - seperate column

parents <- emissions_wide %>% 
  filter(is.na(second)) %>% 
  select(id, label, parent, value)

first_born <- emissions_wide %>% 
  filter(!is.na(second)) %>% 
  group_by(second, first) %>% 
  summarise(value = sum(value), .groups = "drop_last") %>% 
  mutate(id = paste(first, second, sep = " - ")) %>% 
  ungroup() %>% 
  select(id,
         label = second,
         parent = first,
         value)

second_born <- emissions_wide %>% 
  filter(!is.na(third)) %>% 
  group_by(third, second, first) %>% 
  summarise(value = sum(value), .groups = "drop_last") %>% 
  mutate(id = paste(first, second, third, sep = " - ")) %>% 
  mutate(parent = paste(first, second, sep = " - ")) %>% 
  ungroup() %>% 
  select(id,
         label = third,
         parent,
         value)

third_born <- emissions_wide %>% 
  filter(!is.na(fourth)) %>% 
  group_by(fourth, third, second, first) %>% 
  summarise(value = sum(value), .groups = "drop_last") %>% 
  mutate(id = paste(first, second, third, fourth, sep = " - ")) %>% 
  mutate(parent = paste(first, second, third, sep = " - ")) %>% 
  ungroup() %>% 
  select(id,
         label = fourth,
         parent,
         value)

n_potential_child_layers <- emissions_long %>% 
  select(id) %>% 
  pull() %>% 
  str_count(" - ") %>% 
  max()

create_hierarchy_df <- function(df, id_col = "id", id_sep = " - ") {
  n_potential_child_layers <- df %>% 
    select(col) %>% 
    pull() %>% 
    str_count(sep) %>% 
    max()
  
  
}

emissions_long %>% 
  data.frame(stringsAsFactors = FALSE) %>% 
  plot_ly(
    ids = ~id,
    labels = ~label,
    parents = ~parent,
    values = ~value,
    type = "sunburst",
    maxdepth = 2,
    insidetextorientation = 'radial',
    marker=list(colorscale='Portland'),
    text = ~units,
    textinfo='label+percent root+percent entry',
    hoverinfo = paste("%{label}: <br>%{value}",'text')
  )

plot_ly(
  labels = c("Eve", "Seth", "Enos", "Noam", "Awan", "Enoch"),
  parents = c("", "Eve", "Seth", "Seth", "Eve", "Awan"),
  values = c(16, 12, 10, 2, 4, 4),
  type = "sunburst",
  branchvalues = "total"
)

tibble(
  labels = c("Eve", "Seth", "Enos", "Noam", "Awan", "Enoch"),
  parents = c("", "Eve", "Seth", "Seth", "Eve", "Awan"),
  values = c(16, 12, 10, 2, 4, 4)
)

fig <- plot_ly(
  labels = cain_ble$labels,
  parents = cain_ble$parents,
  values = cain_ble$values,
  type = 'sunburst'
)

fig

emissions_long$label[1:10]

 [1] "Agriculture"            "Electricity Generation" "Industry"               "Land use"               "Residential"           
 [6] "Services"               "Transport"              "Waste"                  "Accidental fires"       "Accidental fires"      

d <- data.frame(
    ids = c(
    "North America", "Europe", "Australia", "North America - Football", "Soccer",
    "North America - Rugby", "Europe - Football", "Rugby",
    "Europe - American Football","Australia - Football", "Association",
    "Australian Rules", "Autstralia - American Football", "Australia - Rugby",
    "Rugby League", "Rugby Union"
  ),
  labels = c(
    "North<br>America", "Europe", "Australia", "Football", "Soccer", "Rugby",
    "Football", "Rugby", "American<br>Football", "Football", "Association",
    "Australian<br>Rules", "American<br>Football", "Rugby", "Rugby<br>League",
    "Rugby<br>Union"
  ),
  parents = c(
    "", "", "", "North America", "North America", "North America", "Europe",
    "Europe", "Europe","Australia", "Australia - Football", "Australia - Football",
    "Australia - Football", "Australia - Football", "Australia - Rugby",
    "Australia - Rugby"
  ),
  stringsAsFactors = FALSE
)

fig <- plot_ly(d, ids = ~ids, labels = ~labels, parents = ~parents, type = 'sunburst')

d

class(emissions_long)

[1] "tbl_df"     "tbl"        "data.frame"

class(cain_ble)

[1] "tbl_df"     "tbl"        "data.frame"

diff_order <- ghg_emissions_clean %>% 
  dplyr::group_by(ccp_mapping, year, pollutant) %>% 
  dplyr::summarise(value = sum(value), units = units[1], .groups = "keep") %>%
  filter(pollutant == "CO2") %>% 
  filter(year == min(ghg_emissions_clean$year) |
           year == max(ghg_emissions_clean$year)) %>% 
  ungroup() %>% 
  group_by(ccp_mapping) %>% 
  mutate(diff = lag(value) - value) %>% 
  arrange(diff) %>%
  drop_na() %>% 
  select(ccp_mapping) %>% 
  pull()

ghg_emissions_clean %>% 
  dplyr::group_by(ccp_mapping, year, pollutant) %>% 
  dplyr::summarise(value = sum(value), units = units[1], .groups = "keep") %>%
  filter(pollutant == "CO2") %>%
  mutate(ccp_mapping = factor(ccp_mapping, levels = rev(diff_order))) %>% 
  ggplot() +
  aes(x = year, y = value, fill = ccp_mapping) +
  geom_area() +
  facet_wrap(~pollutant) +
  theme_bw()

ghg_emissions_clean %>% 
  group_by(pollutant) %>% 
  summarise(emissions = sum(value))

plotly::ggplotly(
  ghg_emissions_clean %>% 
    filter(year == 2018) %>%
    filter(pollutant %in% c("CO2", "CH4")) %>%
    ggplot() +
    aes(x = factor(ccp_mapping, levels = rev(levels(factor(ccp_mapping)))),
        y = value, fill = source_name,
        text = paste0('</br> Sector: ', ccp_mapping,
                      '</br> Emissions: ', value,
                      '</br> Source Name: ', source_name)) +
    geom_col(position = "stack") +
    theme_bw() +
    theme(legend.position = "none") +
    labs(x = "Sector",
         y = paste0("Emissions (", ghg_emissions_clean$units[1], ")")) +
    coord_flip(),
    tooltip = 'text'
  )

ghg_emissions_data %>% 
  names()

ghg_emissions_data %>% 
  select()

input <- list()

input$col_choice = "national_communication_categories"

ghg_emissions_clean %>%
  group_by_(input$col_choice, "emission_year") %>% 
  summarise(total_ghg_emissions = sum(emissions)) %>% 
  ggplot() +
  aes(x = EmissionYear, y = total_ghg_emissions, group = `National Communication Categories`, colour = `National Communication Categories`) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks = seq(1990,2020,5)) +
  theme(legend.position = 0)

ghg_emissions_data %>% 
  distinct(`National Communication Categories`)

ghg_emissions_data %>% 
  filter(EmissionYear != "BaseYear") %>% 
  mutate(EmissionYear = as.numeric(EmissionYear)) %>% 
  group_by(EmissionYear) %>% 
  summarise(total_ghg_emissions = sum(`Emissions (MtCO2e)`)) %>% 
  ggplot() +
  aes(x = EmissionYear, y = total_ghg_emissions) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks = seq(1990,2020,5)) +
  ylim(0, 80) +
  theme(legend.position = 0) +
  theme_bw()

ghg_emissions_data %>% 
  distinct(`CCP mapping`)

ghg_emissions_data %>% 
  distinct(`National Communication Categories`)

ghg_emissions_data %>% 
  filter(EmissionYear != "BaseYear") %>% 
  mutate(EmissionYear = as.numeric(EmissionYear)) %>% 
  group_by(`CCP mapping`, EmissionYear) %>% 
  summarise(total_ghg_emissions = sum(`Emissions (MtCO2e)`)) %>% 
  ggplot() +
  aes(x = EmissionYear, y = total_ghg_emissions, group = `CCP mapping`, colour = `CCP mapping`) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks = seq(1990,2020,5))

`summarise()` regrouping output by 'CCP mapping' (override with `.groups` argument)

ghg_emissions_data %>% 
  filter(EmissionYear != "BaseYear") %>% 
  mutate(EmissionYear = as.numeric(EmissionYear)) %>% 
  filter(`National Communication Categories` != `CCP mapping`) %>% 
  select(`National Communication Categories`, `CCP mapping`) %>% 
  unique()

category_id,category_name,subcategory_id,subcategory_name,year,emissions,emission

emissions_sankey <- emissions_data %>% 
  select(ccp_mapping, source_name, pollutant, emission_year, emissions, units)

filtered_df <- ghg_emissions_clean %>% 
  select(ccp_mapping, source_name, pollutant, emission_year, emissions, units) %>% 
  filter(pollutant == "CO2") %>% 
  filter(emission_year == "2005")

total_emissions_for_gas <- filtered_df %>% 
  summarise(sum(emissions)) %>% 
  pull()

total_emissions_by_category <- filtered_df %>% 
  select(-pollutant) %>% 
  group_by(ccp_mapping) %>% 
  summarise(cat_sum = sum(emissions), .groups = 'drop_last')

categories <- filtered_df %>% 
  distinct(ccp_mapping) %>% 
  pull()

n_categories <- length(categories)

sources <- filtered_df %>% 
  distinct(source_name) %>% 
  pull()

n_sources <- length(sources)

n_sources

[1] 159

node_names <- c("Total", categories, sources, "Other")

node_names_df <- data.frame("name" = node_names)

total_sankey_tibble <- total_emissions_by_category %>%
  mutate(total = "Total") %>% 
  mutate(total = match(total, node_names) -1) %>% 
  mutate(ccp_mapping = match(ccp_mapping, node_names) -1) %>% 
  select(source = total,
         target = ccp_mapping,
         value = cat_sum)

total_filtered_emissions <- total_sankey_tibble %>% 
  summarise(sum(value)) %>% 
  pull()

other_emissions <- total_emissions_for_gas - total_filtered_emissions

total_other_sankey_tibble <- tibble(
  "source" = c(0),
  "target" = (match("Other", node_names) -1),
  "value" = c(other_emissions)
)


sub_sankey_tibble <- filtered_df %>% 
  select(- c(units, pollutant, emission_year)) %>% 
  mutate(ccp_mapping = match(ccp_mapping, node_names) -1,
         source_name = match(source_name, node_names) -1)

names(sub_sankey_tibble) = c("source", "target", "value")

sankey_tibble <- total_sankey_tibble %>% 
  bind_rows(sub_sankey_tibble) %>% 
  bind_rows(total_other_sankey_tibble)

links_matrix <- data.frame(as.matrix(sankey_tibble, byrow = TRUE, ncols = 3))

# Add a 'group' column to each connection:
links <- links_matrix %>% 
  mutate(group = case_when(
    source == 0 ~ paste("type_", target, sep = ""),
    source!=0 ~ paste("type_", source, sep = "")
  ))

nodes <- node_names_df
# Add a 'group' column to each node.
# All of them in the same group to make them the same colour
nodes$group <- as.factor(c("my_unique_group"))

emissions <- list()

emissions$nodes <- nodes
emissions$links <- links

total_filtered_emissions <- total_sankey_tibble %>% 
  summarise(sum(value)) %>% 
  pull()

other_emissions <- total_emissions_for_gas - total_filtered_emissions

total_other_sankey_tibble <- tibble(
  "source" = c(0),
  "target" = (match("Other", node_names) -1),
  "value" = c(other_emissions)
)

sub_sankey_tibble <- filtered_tibble %>% 
  select(-category_id, -subcategory_id, -year) %>% 
  mutate(category_name = match(category_name, node_names) -1,
         subcategory_name = match(subcategory_name, node_names) -1)

names(sub_sankey_tibble) = c("source", "target", "value")

sankey_tibble <- total_sankey_tibble %>% 
  bind_rows(sub_sankey_tibble) %>% 
  bind_rows(total_other_sankey_tibble)

links_matrix <- data.frame(as.matrix(sankey_tibble, byrow = TRUE, ncols = 3))

# Add a 'group' column to each connection:
links <- links_matrix %>% 
  mutate(group = case_when(
    source == 0 ~ paste("type_", target, sep = ""),
    source!=0 ~ paste("type_", source, sep = "")
  ))

nodes <- node_names_df
# Add a 'group' column to each node.
# All of them in the same group to make them the same colour
nodes$group <- as.factor(c("my_unique_group"))

emissions <- list()

emissions$nodes <- nodes
emissions$links <- links

make_sankey_dfs <- function(data, userYear, userGas) {
  n_categories <- data %>% 
    distinct(category_name) %>% 
    nrow()
  
  total_emissions_for_gas <- data %>% 
    filter(emission == userGas()) %>% 
    filter(year == userYear()) %>%
    summarise(sum(emissions)) %>% 
    pull()
  
  filtered_tibble <- data %>%
    filter(emission == userGas()) %>% 
    select(-emission) %>% 
    filter(year == userYear()) %>% 
    filter(emissions > userResolution())
  
  total_emissions_by_cat <- filtered_tibble %>%
    group_by(category_name) %>% 
    summarise(cat_sum = sum(emissions), .groups = 'drop_last')
  
  categories <- filtered_tibble %>%
    distinct(category_name) %>% 
    pull()
  
  subcategories <- filtered_tibble %>%
    distinct(subcategory_name) %>% 
    pull()
  
  node_names <- c("Total", categories, subcategories, "Other")
  
  node_names_df <- data.frame("name" = node_names)
  
  total_sankey_tibble <- total_emissions_by_cat %>%
    mutate(total = "Total") %>% 
    mutate(total = match(total, node_names) -1) %>% 
    mutate(category_name = match(category_name, node_names) -1) %>% 
    select(source = total,
           target = category_name,
           value = cat_sum)
  
  total_filtered_emissions <- total_sankey_tibble %>% 
    summarise(sum(value)) %>% 
    pull()
  
  other_emissions <- total_emissions_for_gas - total_filtered_emissions
  
  total_other_sankey_tibble <- tibble(
    "source" = c(0),
    "target" = (match("Other", node_names) -1),
    "value" = c(other_emissions)
  )
  
  sub_sankey_tibble <- filtered_tibble %>% 
    select(-category_id, -subcategory_id, -year) %>% 
    mutate(category_name = match(category_name, node_names) -1,
           subcategory_name = match(subcategory_name, node_names) -1)
  
  names(sub_sankey_tibble) = c("source", "target", "value")
  
  sankey_tibble <- total_sankey_tibble %>% 
    bind_rows(sub_sankey_tibble) %>% 
    bind_rows(total_other_sankey_tibble)
  
  links_matrix <- data.frame(as.matrix(sankey_tibble, byrow = TRUE, ncols = 3))
  
  # Add a 'group' column to each connection:
  links <- links_matrix %>% 
    mutate(group = case_when(
      source == 0 ~ paste("type_", target, sep = ""),
      source!=0 ~ paste("type_", source, sep = "")
    ))
  
  nodes <- node_names_df
  # Add a 'group' column to each node.
  # All of them in the same group to make them the same colour
  nodes$group <- as.factor(c("my_unique_group"))
  
  emissions <- list()
  
  emissions$nodes <- nodes
  emissions$links <- links
  
  return(emissions)
}

make_sankey_dfs(emissions_sankey, userYear = 2005, userGas = "CH4", userResolution = 50)